(ns geometrician.State
  (:require [clojure.pprint :refer :all]))

(defn in? 
  "true if seq contains elm"
  [seq elm]  
  (some #(= elm %) seq))

;; X, square, circle, triangle...

(defn number-to-key [number]
  (let [number (mod number 4)
        keys {0 :x
              1 :square
              2 :circle
              3 :triangle}]
    (keys number)))

(defn gen-cell []
  (number-to-key (rand-int 5)))

(def gen-initial-vertical-row
  (partial (fn gen-initial-vertical-row-inner [index old prev-v-row count]
             (try
               (if (< index count)
               (try
                 (loop [cell (gen-cell)]
                 (if (or (= cell old)
                         (= cell (nth prev-v-row index)))
                   (recur (gen-cell))
                   (cons cell
                         (gen-initial-vertical-row-inner (inc index) cell prev-v-row count))))
                 (catch ClassCastException ex
                   (println "LOL"))))
               (catch ClassCastException ex
                 (println "LOLLERO")))) 0 :dumb-value))
      

(def gen-horizontal-row
  (partial (fn gen-horizontal-row-inner [previous-v-row index W H]
             (if (< index W)
               (let [current-v-row (gen-initial-vertical-row previous-v-row H)]
                 (cons current-v-row
                       (gen-horizontal-row-inner current-v-row (inc index) W H))))) nil 0))
  

(assert (= (->>
            (gen-horizontal-row 4 10)
            (map count)
            vector)
           (->
            (repeat 4 10)
            vector)))

(defn cell-at [world-image x y]
  (let [row (nth world-image x)]
    (nth row y)))

;(cell-at @the-world 15 11) ;;To test... something?

;(pprint (partition-by (fn [kw] kw) (first @the-world)))

(defn transpose [seq-of-seqs]
  {:pre [(not (empty? seq-of-seqs))]}
  (try
    (apply mapv vector seq-of-seqs)
    (catch clojure.lang.ArityException ex
      (println "ArityEx @ transpose")
      (println "seq-of-seqs: " seq-of-seqs)
      (throw ex))))

(defn contains-horizontal-starys? [hor-row]
  {:pre [(not (empty? hor-row))]}
  (if-not (nil? hor-row)
    (if (keyword? (first hor-row))
      (not (nil? (->> hor-row
                      (partition-by (fn [kw] kw))
                      (filter #(>= (count %) 3))
                      (some #(not (nil? %))))))
      (try
        (or (some contains-horizontal-starys? hor-row)
            (some contains-horizontal-starys? (transpose hor-row)))
        (catch clojure.lang.ArityException ex
          (println "ArEx käy contains-horizontal-starysin kautta")
          (println "horrow: " hor-row)
          (throw ex))))
    (throw (Exception. (str "contains-hor-starys sai roskadataa: " hor-row)))))
        

(defn swap
  ([hor-row y1 y2]
     (assoc (vec hor-row)
       y2 (nth hor-row y1)
       y1 (nth hor-row y2)))
  ([world x1 y1 x2 y2]
     (if (= x1 x2)
       (assoc world x1 (swap (nth world x1) y1 y2))
       (try
         (let [row1 (-> (nth world x1) vec)
               row2 (-> (nth world x2) vec)
               new-row1 (assoc row1 y1 (nth row2 y2))
               new-row2 (assoc row2 y2 (nth row1 y1))]
;           (println "rowt rakennettu")
           (assoc world
             x1 new-row1
             x2 new-row2))
         (catch ClassCastException ex
           (println "CCE @ SWAP")
           (throw ex))
         (catch IndexOutOfBoundsException ex
           (println "IOOBE@SWAP: Indexes " [x1 y1 x2 y2])
           (println "the world:")
;           (pprint world)
           (throw ex))))))
                    

(defn can-cells-swap? [the-world [x1 y1] [x2 y2]] 
  (let [coordinate-diffs [(- x1 x2) (- x2 x1) (- y1 y2) (- y2 y1)]] 
    (if-not (or (some #(not (in? [1 0 -1] %)) coordinate-diffs)
                (in? [[-1 1 1 -1]  ;;This cruel hack takes care of the lean-cases...
                      [1 -1 1 -1]
                      [1 -1 -1 1]
                      [-1 1 -1 1]] coordinate-diffs))
      (let [possible-world (swap (vec (map vec the-world)) x1 y1 x2 y2)]
        (println coordinate-diffs)
        (try
          (contains-horizontal-starys? possible-world)
          (catch ClassCastException ex
            (println "the-world: ")
            (pprint the-world)
            (println "possible-world: ")
            (pprint possible-world)
            (println "koords: " [x1 y1 x2 y2])
            (println "CCE @ can-cells.."))))
      (do
        (println "Etäisyystarkistus rikki  " coordinate-diffs)
        false))))

(defn indexes-of-straights
  "Creates a seq of indexes where are removeable straights. We assume the caller has already checked the-world with contains-horizontal-starys?"
  [the-world]
  (let [transposed-world (->> the-world
                              transpose
                              (map #(partition-by (fn [kw] kw) %)))
        the-world (->> the-world
                       (map #(partition-by (fn [kw] kw) %)))
        consser (partial (fn consser [coord row]
                           (if-not (empty? row)
                             (if (>= (count (first row)) 3)
                               (cons (range coord (+ coord (count (first row))))
                                     (consser (+ coord (count (first row))) (rest row)))
                               (consser (+ coord (count (first row))) (rest row))))) 0)
        x-consser (partial (fn x-consser [x the-world]
                             (if-not (empty? the-world)
                               (if-let [y-result (consser (first the-world))]
                                 (cons [x (flatten y-result)]
                                       (x-consser (inc x) (rest the-world)))
                                 (x-consser (inc x) (rest the-world))))) 0)]
    [(x-consser the-world)
     (x-consser transposed-world)]))

(def caar #(-> % first first))
(def cadr #(-> % first rest))
                     
;;;; [([x (y y y)][x (y y y y)]) ([y (x x x)] [y (x x x x x)])] => [[[x] [y y y]][[x] [y y y y]] [[x x x] y] [x x x x x] [y]]

(defn flatten-index-results [results]
  (defn flattener [[x-y-blocks y-x-blocks]]
    (if-not (empty? x-y-blocks)
      (cons [(vector (caar x-y-blocks)) (first (rest (first x-y-blocks)))]
            (flattener [(rest x-y-blocks) y-x-blocks]))
      (if-not (empty? y-x-blocks)
        (let [[y xs] (first y-x-blocks)]
          (cons [(vec xs) [y]]
                (flattener ['() (rest y-x-blocks)]))))))
  (-> results
      flattener
      vec))
  

(def the-world (atom (gen-horizontal-row (/ 800 50) (/ 600 50))))

(defn vec-remove
  "remove elem in coll"
  [coll pos]
  (vec (concat (subvec coll 0 pos) (subvec coll (inc pos)))))

(defn remove-element [two-d-seq x y]
  (try
    (assoc two-d-seq x
           (assoc (nth two-d-seq x) y :remove-me!))
    (catch IndexOutOfBoundsException ex
      (println "IOOBE @ remove-element with vals count-x: " (count two-d-seq) ", count-y: " (count (nth two-d-seq x)) ", x: " x ", y: " y)
;      (println "two-d-seq: ")
;      (pprint two-d-seq)
      (throw ex))))

(comment (map #(filter (fn [elm] (not (= elm :remove-me!))) %)
              the-world))

(defn remove-nice-rows [the-world & {:keys [score-out] :or {score-out (atom 0)}}]
  (let [toret (loop [the-world the-world
                     indexes (-> the-world
                                 indexes-of-straights
                                 flatten-index-results)]
                (if (empty? indexes)
                  the-world
                  (let [[xs ys] (first indexes)
                        xs (if (= (count xs) 1)
                             (repeat (count ys) (first xs))
                             xs)
                        ys (if (= (count ys) 1)
                             (repeat (count xs) (first ys))
                             ys)
                        remover (fn [the-world xs ys]
                                  (let [the-world (vec (map vec the-world))]
                                    (if (some empty? [xs ys])        
                                      the-world
                                      (recur (remove-element the-world (first xs) (first ys))
                                             (rest xs) (rest ys)))))]
                    (recur (remover the-world xs ys) (rest indexes)))))
        count-of-remove-mes (->> toret flatten
                                 (filter #(= % :remove-me!))
                                 count)]
    (swap! score-out + (* count-of-remove-mes 10))
    (map #(filter (fn [elm] (not (= elm :remove-me!))) %) toret)))
        
(comment      
(defn remove-nice-rows [the-world]
  (try
    (loop [the-world the-world] ;;Because one can't recur through trys....
      (cond
       (contains-horizontal-starys? the-world)
       (recur (if (contains-horizontal-starys? the-world)
                (let [indexes (-> the-world
                                  indexes-of-straights
                                  flatten-index-results)]
                  (loop [indexes indexes
                         the-world the-world]
                    (if (empty? indexes)
                      (do
                        (println "empty indexes! stopping recurring")
                        the-world)
                      (let [[xs ys] (first indexes)
                            xs (if (= (count xs) 1)
                                 (repeat (count ys) (first xs))
                                 xs)
                            ys (if (= (count ys) 1)
                                 (repeat (count xs) (first ys))
                                 ys)
                            remover (fn [the-world xs ys]
                                      (let [the-world (vec (map vec the-world))]
                                        (if (some empty? [xs ys])
                                        (map #(filter (fn [elm] (not (= elm :remove-me!))) %)
                                             the-world)

                                            (recur (remove-element the-world (first xs) (first ys))
                                                   (rest xs) (rest ys)))))]
                        (println "indexes: " indexes)
                        (println "recurring")
                        (recur (rest indexes) (remover the-world xs ys))))))
                the-world))
       
       :t the-world))
    (catch IndexOutOfBoundsException ex
      (println "IOOBE @ remove-nice-rows")
      (throw ex)))))

(defn fill-reduced-colums [the-world h]
  (let [filler (fn [column]
                 (if (< (count column) h)
                   (recur (cons (gen-cell) column))
                   column))]
    (map filler the-world)))


                     
